home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / text-mode.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  4KB  |  120 lines
  1. ;;;; text-mode.jl -- Modes for editing English text
  2. ;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'text-mode)
  21.  
  22. ;; Taken from fill-mode.jl
  23. (defvar fill-column 71)
  24.  
  25. (defvar text-mode-keymap (make-keylist))
  26. (bind-keys text-mode-keymap
  27.   "Meta-s" 'center-line
  28.   "Meta-S" 'center-paragraph)
  29.  
  30. (defvar text-mode-indent-keymap (make-keylist))
  31. (bind-keys text-mode-indent-keymap
  32.   "TAB" 'text-mode-indent-tab)
  33.  
  34. (defun text-mode-init ()
  35.   (setq major-mode-kill 'text-mode-kill
  36.     word-regexp "[a-zA-Z0-9_-]"
  37.     word-not-regexp "[^a-zA-Z0-9_-]|$"))
  38.  
  39. ;;;###autoload
  40. (defun text-mode ()
  41.   "Mode for editing English text in."
  42.   (interactive)
  43.   (when major-mode-kill
  44.     (funcall major-mode-kill (current-buffer)))
  45.   (setq mode-name "Text"
  46.     major-mode 'text-mode
  47.     keymap-path (cons 'text-mode-keymap keymap-path))
  48.   (text-mode-init)
  49.   (eval-hook 'text-mode-hook))
  50.  
  51. ;;;###autoload
  52. (defun indented-text-mode ()
  53.   "Variant of `text-mode' in which the TAB key indents to the depth of the
  54. previous line, then works as normal."
  55.   (interactive)
  56.   (when major-mode-kill
  57.     (funcall major-mode-kill (current-buffer)))
  58.   (setq mode-name "Indented Text"
  59.     major-mode 'indented-text-mode
  60.     keymap-path (cons 'text-mode-indent-keymap
  61.               (cons 'text-mode-keymap keymap-path)))
  62.   (text-mode-init)
  63.   (eval-hook 'text-mode-hook)
  64.   (eval-hook 'indented-text-mode-hook))
  65.  
  66. (defun text-mode-kill ()
  67.   (setq mode-name nil
  68.     keymap-path (delq 'text-mode-keymap 
  69.               (delq 'text-mode-indent-keymap keymap-path))
  70.     major-mode nil
  71.     major-mode-kill nil)
  72.   t)
  73.  
  74. (defun text-mode-indent-tab ()
  75.   (interactive)
  76.   (let
  77.       ((pos (find-prev-regexp "^.+$" (prev-line 1))))
  78.     (if (or (null pos) (> (pos-col (cursor-pos)) (line-length pos)))
  79.     (insert "\t")
  80.       (let
  81.           ((gcurs (char-to-glyph-pos (cursor-pos))))
  82.         (set-pos-line gcurs (pos-line pos))
  83.         (setq pos (glyph-to-char-pos gcurs))
  84.     (find-next-regexp "[\t ]+|$" pos)
  85.     (if (equal (match-end) (line-end pos))
  86.         (insert "\t")
  87.       (setq pos (char-to-glyph-pos (match-end)))
  88.       (set-pos-line pos (pos-line (cursor-pos)))
  89.       (if (empty-line-p pos)
  90.           (set-indent-pos pos)
  91.         (indent-to (pos-col pos))))))))
  92.  
  93. ;;;###autoload
  94. (defun center-line (&optional pos)
  95.   "Centre the line at POS."
  96.   (interactive)
  97.   (regexp-match-line " *$" pos)
  98.   (let*
  99.       ((spos (indent-pos pos))
  100.        (epos (char-to-glyph-pos (match-start)))
  101.        (len (- (pos-col epos) (pos-col spos))))
  102.     (cond
  103.       ((<= len 0))
  104.       ((> len fill-column)
  105.     (set-indent-pos (line-start pos)))
  106.       (t
  107.     (set-pos-col spos (/ (- fill-column len) 2))
  108.     (set-indent-pos spos)))))
  109.  
  110. ;;;###autoload
  111. (defun center-paragraph (&optional pos)
  112.   "Centre the paragraph surrounding POS."
  113.   (interactive)
  114.   (let*
  115.       ((epos (forward-paragraph pos))
  116.        (spos (backward-paragraph epos)))
  117.     (while (< spos epos)
  118.       (center-line spos)
  119.       (next-line 1 spos))))
  120.